home *** CD-ROM | disk | FTP | other *** search
- unit Unit1;
-
- (* Quick example of tObjectList's uses : Streaming & Iterators*)
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, StdCtrls;
-
- type
- TForm1 = class(TForm)
- Label1: TLabel;
- Label2: TLabel;
- Label3: TLabel;
- Button1: TButton;
- procedure FormCreate(Sender: TObject);
- procedure Button1Click(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
- var
- Form1: TForm1;
-
- implementation
- Uses tContain;
- {$R *.DFM}
-
- type
- tCl1 = Class(tObject)
- Public
- D:Integer;
- Constructor Create;
- Procedure Store(S:tStream); virtual;
- Procedure Load(S:tStream); virtual;
- end;
-
- tCl2 = Class(tCl1)
- Constructor Create;
- end;
-
- tCl3 = Class(tCl2)
- B:Array[0..1024] of byte;
- Constructor Create;
- Procedure Store(S:tStream); override;
- Procedure Load(S:tStream); override;
- end;
-
-
- Constructor tCl1.Create;
- begin
- D:=1;
- end;
-
-
- Procedure tCl1.Store(S:tStream);
- begin
- S.WriteBuffer(D,SizeOf(D));
- end;
-
- Procedure tCl1.Load(S:tStream);
- begin
- S.ReadBuffer(D,SizeOf(D));
- end;
-
-
- Constructor tCl2.Create;
- begin
- Inherited Create;
- Inc(D);
- end;
-
- Constructor tCl3.Create;
- begin
- Inherited Create;
- Inc(D);
- FillChar(B,1024,#3);
- end;
-
- Procedure tCl3.Store(S:tStream);
- begin
- Inherited Store(S);
- S.WriteBuffer(B,SizeOf(B));
- end;
-
- Procedure tCl3.Load(S:tStream);
- begin
- Inherited Load(S);
- S.ReadBuffer(B,SizeOf(B));
- end;
-
- Var List:tObjectList;
-
- procedure TForm1.FormCreate(Sender: TObject);
- Var P1,P2,P3:tCl1;
- begin
- List:=tObjectList.Create;
-
- List.Insert(0,tCl1.Create); (* Put a tCl1 instance in position 0 *)
- List.AddObject(tCl2.Create);(* Add a tCl2 instance *)
- List.Insert(0,tCl3.Create); (* Put a tCl3 instance in position 0, pushing the
- tCl1 & tcl2 instances to position 1 and 2 *)
-
- List.SaveToStream('\test.str'); (* Store all 3 objects by calling their Store methods *)
- List.Free; (* Dispose of the 3 objects and frees itself *)
-
- List:=tObjectList.CreateFromStream('\test.str'); (* Re create from streamed file*)
-
- P1:=List.Items[0] as tCl1; (* Access each, after loading from stream *)
- P2:=List.Items[1] as tCl1;
- P3:=List.Items[2] as tCl1;
-
- (* Even if the P1,2 & 3 variables have been typecast to tCl1, they still
- retain there original class, as shown by the call to
- their ClassName method. (The ClassName method is inherited
- from tObject) *)
- Label1.Caption:=Format('%s : D=%d',[P1.ClassName,P1.D]);
- Label2.Caption:=Format('%s : D=%d',[P2.ClassName,P2.D]);
- Label3.Caption:=Format('%s : D=%d',[P3.ClassName,P3.D]);
- end;
-
- procedure TForm1.Button1Click(Sender: TObject);
- (* This shows how to use the tObjectList iterators. Note that SeePx is
- 1- Embedded
- 2- Declared FAR
- Note also the use of tCl1 which is the common ancestor *)
- Procedure SeePx(AP:tCl1); far;
- begin
- Case List.IndexOf(AP) of
- 0: Label1.Caption:=Format('%s instance size=%d',[Ap.ClassName,ap.InstanceSize]);
- 1: Label2.Caption:=Format('%s instance size=%d',[Ap.ClassName,Ap.InstanceSize]);
- 2: Label3.Caption:=Format('%s instance size=%d',[Ap.ClassName,Ap.InstanceSize]);
- end;
-
- end;
- begin
- List.ForEach(@SeePx);
- end;
-
- procedure TForm1.FormDestroy(Sender: TObject);
- begin
- If Assigned(List)
- then List.Free; (* This will Free all 3 objects before destroying list *)
- end;
-
- Initialization
- RegisterClass(@tCl1.Load,@tCl1.Store,tCl1);
- RegisterClass(@tCl2.Load,@tCl2.Store,tCl2);
- RegisterClass(@tCl3.Load,@tCl3.Store,tCl3);
- end.